unit Sort;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics,
  Controls, Forms, Dialogs, ComCtrls,
  ExtCtrls, StdCtrls, Buttons, Types;

type
  TForm1 = class(TForm)
    Img: TImage;
    TrackBar: TTrackBar;
    Timer: TTimer;
    BitBtn1: TBitBtn;
    ProgressBar: TProgressBar;
    CheckBox: TCheckBox;
    procedure BitBtn1Click(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
    procedure TrackBarChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const
  n = 56;

var
  Form1: TForm1;
  i, j, sum, s: integer;
  arr: Array[0..n-1] of integer;

implementation

{$R *.dfm}

procedure TForm1.BitBtn1Click(Sender: TObject);
var l, r: integer;
begin
  i := 0;
  j := n-2;
  sum := 0;
  s:=0;

  for l := 0 to n-1 do
    arr[l] := 0;

  if CheckBox.Checked then
    for l := 0 to n-1 do
      arr[l] := random( img.Height - 4 ) + 4
  else
    for l := 1 to n-1 do
      repeat
        r := random(n);
        if arr[r] = 0 then
          arr[r] := l*4;
      until arr[r] = l*4;

  Timer.Enabled := true;
end;

Procedure Draw(index, color: byte);
  procedure DrawEl( p: TPoint; Color: byte );
  begin
    if color = 0 then
      Form1.Img.Canvas.Brush.Color := clLime
    else if color = 1 then
      Form1.Img.Canvas.Brush.Color := clRed
    else Form1.Img.Canvas.Brush.Color := clSkyBlue;
    Form1.Img.Canvas.Rectangle( p.X, 0, p.X+10, p.Y );
  end;
var
  l: integer;
begin
  Form1.Img.Canvas.Brush.Color := clWhite;
  Form1.Img.Canvas.FillRect( Form1.Img.Canvas.ClipRect );
  for l := 0 to n-1 do
    if ( index = l ) or ( index = l + 1 ) then
      DrawEl( point(l*10, arr[l]), color )
    else
      DrawEl( point(l*10, arr[l]), 2 )
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
  randomize;
end;

procedure TForm1.TimerTimer(Sender: TObject);
  Procedure Swap( var a, b: integer );
  begin
    a := a xor b;
    b := a xor b;
    a := a xor b;
  end;
begin
  if arr[j] > arr[j+1] then begin
    Draw( j, 1 );
    Swap( arr[j], arr[j+1] );
    s:=s+1;
  end else begin
    Draw( j, 0 );
    inc(i);
    j := n - i - 2;
    exit;
  end;
  if (j = (n - 2)) then begin
    inc(i);
    j := n - i - 2;
  end else
    inc(j);
  if i = n-1 then begin
    Timer.Enabled := false;
    sum := -1;
  end;

  inc(sum);
  ProgressBar.Position := round( 100*( sum/( (n-1)*(n-1)-(n)*(n-1)/2 ) ) );
end;

procedure TForm1.TrackBarChange(Sender: TObject);
begin
  Timer.Interval :=  TrackBar.Max - TrackBar.Position + 1;
end;

end.
